(*******************************************************************************
 * Copyright (c) 2024 Lonely.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and/or associated documentation files (the
 * "Materials"), to deal in the Materials without restriction, including
 * without limitation the rights to use, copy, modify, merge, publish,
 * distribute, sublicense, and/or sell copies of the Materials, and to
 * permit persons to whom the Materials are furnished to do so, subject to
 * the following conditions:
 *
 * The above copyright notice and this permission notice shall be included
 * in all copies or substantial portions of the Materials.
 *
 * THE MATERIALS ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 * MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS.
 ******************************************************************************)
unit SimpleBitmap;
interface
uses
  CL_platform,
  CL,
  System.Math,
  Generics.Collections,
  System.SysUtils,
  system.Classes;
type
  TSimpleBitmap = class;
  TBitmapFileHeader = packed record
    bfType: Word;
    bfSize: Int32;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: Int32;
  end;
  PBitmapFileHeader = ^TBitmapFileHeader;
  TBitCount = (bit_8,bit_16,bit_24,bit_32,bit_Unknown);
  TBitmapInfoHeader = packed record
    biSize: Int32;
    biWidth: Int32;
    biHeight: Int32;
    biPlanes: Word;
    biBitCount: Word;
    biCompression: Int32;
    biSizeImage: Int32;
    biXPelsPerMeter: Int32;
    biYPelsPerMeter: Int32;
    biClrUsed: Int32;
    biClrImportant: Int32;
  end;
  PBitmapInfoHeader = ^TBitmapInfoHeader;
  TRgbQuad = packed record
    rgbBule:Byte;
    rgbGreen:Byte;
    rgbRed:Byte;
    rgbReserved:Byte;
  end;
  PRgbQuad = ^TRgbQuad;
{ TColorPalette }
  TColorPalette = class(TObject)
  protected
    FSender:TSimpleBitmap;
    FColorPalette:TList<PRgbQuad>;
    procedure OnListFree(Sender: TObject; const Item: PRgbQuad;Action:TCollectionNotification);
    /// <summary>
    /// 读取调色板项
    /// </summary>
    /// <param name="Index"></param>
    /// <returns></returns>
    function GetRGB(Index:integer):PRgbQuad;
    /// <summary>
    /// 读取调色板数量
    /// </summary>
    /// <returns></returns>
    function GetCount:Integer;
  public
    /// <summary>
    /// 增加调色板条目
    /// </summary>
    /// <param name="R">R</param>
    /// <param name="G">G</param>
    /// <param name="B">B</param>
    /// <returns>返回调色板条目</returns>
    function Add(R,G,B:Byte):Integer;
    /// <summary>
    /// 移除调色板条目
    /// </summary>
    /// <param name="Index"></param>
    /// <returns></returns>
    function Remove(Index:Integer):Boolean;
    /// <summary>
    /// 清空调色板
    /// </summary>
    procedure Clear;
    /// <summary>
    /// 初始化
    /// </summary>
    /// <param name="ASender">Bmp对象</param>
    constructor Create(ASender:TSimpleBitmap);
    destructor Destroy; override;
    /// <summary>
    /// 生成调色板数据
    /// </summary>
    procedure Compile;
    /// <summary>
    /// 加载调色板数据
    /// </summary>
    /// <param name="ABuff"></param>
    /// <param name="ASize"></param>
    /// <returns></returns>
    function Load(ABuff:Pointer;ASize:integer):Boolean;
    property Item[Index:integer]:PRgbQuad read getrgb;default;
    property Count:Integer read GetCount;
  published
  end;
{ TSimpleBitmap }
  /// <summary>
  /// 快捷bmp读写对象
  /// </summary>
  /// <remarks>
  /// 非线程安全对象，使用时请自行处理多线程访问。
  /// </remarks>
  TSimpleBitmap = class(TObject)
  protected
    /// <summary>
    /// 是否对象内部申请内存
    /// </summary>
    /// <remarks>
    /// 该布尔值决定是否在Destroy时释放内存。
    /// </remarks>
    FNewBitmap:Boolean;
    /// <summary>
    /// BMP文件头结构
    /// </summary>
    FBitmapFileHeader :PBitmapFileHeader;
    /// <summary>
    /// BMP文件信息结构
    /// </summary>
    FBitmapInfoHeader :PBitmapInfoHeader;
    /// <summary>
    /// BMP调色板结构
    /// </summary>
    FColorPalette:Pointer;
    /// <summary>
    /// BMP调色板大小
    /// </summary>
    FColorPaletteSize:Int32;
    /// <summary>
    /// BMP数据指针
    /// </summary>
    FBitmap:Pointer;
    /// <summary>
    /// BMP数据大小
    /// </summary>
    FBitmapSize:Int32;
    /// <summary>
    /// BMP长宽
    /// </summary>
    FHeight,FWidth:Int32;
    /// <summary>
    /// BMP像素格式
    /// </summary>
    FPixBitFormat:TBitCount;
    /// <summary>
    /// 调色板管理对象
    /// </summary>
    FColorPaletteClass:TColorPalette;
    FFormat: TCL_image_format;
    procedure CreateCLFormat;
    /// <summary>
    /// 初始化文件头
    /// </summary>
    procedure InitFileHeader;virtual;
    /// <summary>
    /// 初始化信息头
    /// </summary>
    /// <param name="AHeight">图像高度</param>
    /// <param name="AWidth">图像宽度</param>
    /// <param name="ABitCount">像素类型</param>
    procedure InitInfoHeader(AHeight,AWidth:Int32;ABitCount:Word);virtual;
    /// <summary>
    /// 创建调色板数据
    /// </summary>
    /// <returns></returns>
    function InitColorPalette(ARgbQuad:array of TRgbQuad):Int32;virtual;
  public
    /// <summary>
    /// 将枚举类型TBitCount转换为word
    /// </summary>
    /// <param name="Value">枚举类型</param>
    /// <returns></returns>
    function BitCount2Word(Value:TBitCount):Word;virtual;
    /// <summary>
    /// 将word转换为枚举类型
    /// </summary>
    /// <param name="Value"></param>
    /// <returns></returns>
    function Word2BitCount(Value:Word):TBitCount;virtual;
    /// <summary>
    /// 获取像素大小
    /// </summary>
    /// <returns></returns>
    function GetPixSize:Int32;overload;virtual;
    /// <summary>
    /// 获取像素大小
    /// </summary>
    /// <param name="Value">像素格式</param>
    /// <returns></returns>
    function GetPixSize(Value:TBitCount):Int32;overload;virtual;
    /// <summary>
    /// 获取行大小
    /// </summary>
    /// <returns></returns>
    function GetLineSize:Int32;overload;virtual;
    /// <summary>
    /// 获取行大小
    /// </summary>
    /// <param name="AWidth">行宽</param>
    /// <param name="APixBitFormat">像素格式</param>
    /// <returns></returns>
    function GetLineSize(AWidth:Int32;APixBitFormat:TBitCount):Int32;overload;virtual;
    /// <summary>
    /// 保存文件
    /// </summary>
    /// <param name="AFile"></param>
    procedure SaveToFile(AFile:string);overload;virtual;
    /// <summary>
    /// 保存图像数据到文件
    /// </summary>
    /// <param name="AFile"></param>
    procedure SaveBitMapDataToFile(AFile:string);overload;virtual;
    /// <summary>
    /// 创建空白位图
    /// </summary>
    /// <param name="AHeight">图像高度</param>
    /// <param name="AWidth">图像宽度</param>
    /// <param name="APixBitFormat">像素格式</param>
    constructor Create(AHeight,AWidth:Int32;APixBitFormat:TBitCount = bit_24);overload;virtual;
    /// <summary>
    /// 使用已有数据构造位图
    /// </summary>
    /// <param name="AHeight">图像高度</param>
    /// <param name="AWidth">图像宽度</param>
    /// <param name="Data">图像数据指针</param>
    /// <param name="DataSize">图像数据大小,如果为0则根据图像宽度高度及像素格式进行计算</param>
    /// <param name="APixBitFormat">像素格式</param>
    constructor Create(AHeight,AWidth:Int32;Data:Pointer;DataSize:Int32;APixBitFormat:TBitCount = bit_24);overload;virtual;
    /// <summary>
    /// 打开位图
    /// </summary>
    /// <param name="AFileName">位图文件名</param>
    constructor Create(AFileName:string);overload;virtual;
    /// <summary>
    /// 设置位图数据指针
    /// </summary>
    /// <param name="Data">位图数据指针</param>
    /// <remarks>
    /// 强制设置位图指针，不会更改位图信息。
    /// </remarks>
    procedure SetPointer(Data:Pointer);overload;virtual;
    /// <summary>
    /// 设置位图数据指针
    /// </summary>
    /// <param name="AHeight">高</param>
    /// <param name="AWidth">宽</param>
    /// <param name="Data">位图数据指针</param>
    /// <param name="DataSize">位图数据大小</param>
    /// <param name="APixBitFormat">位图像素格式</param>
    /// <remarks>
    /// 强制设置位图指针和位图信息。
    /// </remarks>
    procedure SetPointer(AHeight,AWidth:Int32;Data:Pointer;DataSize:Int32;APixBitFormat:TBitCount = bit_24);overload;virtual;
    /// <summary>
    /// 释放位图
    /// </summary>
    destructor Destroy; override;
    /// <summary>
    /// 位图数据指针
    /// </summary>
    /// <remarks>
    /// 非指定数据创建的位图，指针的释放由本对象内部管理，指定数据创建的位图则由用户自行释放。
    /// </remarks>
    property Bitmap:Pointer read FBitmap write FBitmap;
    /// <summary>
    /// 位图数据大小
    /// </summary>
    property BitMapSize:Int32 read FBitmapSize write FBitmapSize;
    /// <summary>
    /// 宽
    /// </summary>
    property Width:Int32 read FWidth;
    /// <summary>
    /// 高
    /// </summary>
    property Height:Int32 read FHeight;
    /// <summary>
    /// 行大小
    /// </summary>
    property LineSize:Int32 read GetLineSize;
    /// <summary>
    /// 调色板对象
    /// </summary>
    property ColorPalette:TColorPalette READ FColorPaletteClass WRITE FColorPaletteClass;
    /// <summary>
    /// 获取像素
    /// </summary>
    /// <param name="X"></param>
    /// <param name="AHeight"></param>
    /// <param name="PixMem"></param>
    procedure GetPix(x,y:Integer;PixMem:PByte);
    property Format: TCL_image_format read FFormat;
  published
  end;

implementation

{ TSimpleBitmap }
function TSimpleBitmap.BitCount2Word(Value:TBitCount): Word;
begin
  case Value of
    bit_8:result := 8;
    bit_16:result := 16;
    bit_24:result := 24;
    bit_32:result := 32;
  end;
end;
constructor TSimpleBitmap.Create(AHeight,AWidth:Int32;APixBitFormat:TBitCount = bit_24);
begin
  if APixBitFormat = bit_Unknown then
    raise Exception.Create('PixBitFormat is bit_Unknown');
  FBitmapFileHeader := AllocMem(SizeOf(TBitmapFileHeader));
  FBitmapInfoHeader := AllocMem(SizeOf(TBitmapInfoHeader));
  FColorPaletteClass := TColorPalette.Create(Self);
  FHeight := AHeight;
  FWidth := AWidth;
  FPixBitFormat := APixBitFormat;
  //初始化其他头信息
  InitInfoHeader(FHeight,FWidth,BitCount2Word(FPixBitFormat));
  InitFileHeader;
  FNewBitmap := True;
  FBitmapSize := Abs(AHeight) * GetLineSize;
  FBitmap := AllocMem(FBitmapSize);
  CreateCLFormat;
end;
constructor TSimpleBitmap.Create(AHeight, AWidth: Int32; Data: Pointer;
  DataSize: Int32; APixBitFormat: TBitCount);
begin
  FBitmapFileHeader := AllocMem(SizeOf(TBitmapFileHeader));
  FBitmapInfoHeader := AllocMem(SizeOf(TBitmapInfoHeader));
  FColorPaletteClass := TColorPalette.Create(Self);
  FHeight := AHeight;
  FWidth := AWidth;
  FPixBitFormat := APixBitFormat;
  //初始化其他头信息
  InitInfoHeader(FHeight,FWidth,BitCount2Word(FPixBitFormat));
  InitFileHeader;
  FNewBitmap := False;
  if DataSize > 0 then
  begin
    FBitmapSize := Abs(AHeight) * GetLineSize;
    FBitmapSize := DataSize
  end
  else
    FBitmapSize := Abs(AHeight) * GetLineSize;
  FBitmap := Data;
  CreateCLFormat;
end;
constructor TSimpleBitmap.Create(AFileName: string);
var
  LFs:TMemoryStream;
  LColorPalette:Pointer;
  LColorPaletteSize:Integer;
begin
    LFs := TMemoryStream.Create;
    LFs.LoadFromFile(AFileName);
    LFs.Position := 0;
    FNewBitmap := True;
    FBitmapFileHeader := AllocMem(SizeOf(TBitmapFileHeader));
    FBitmapInfoHeader := AllocMem(SizeOf(TBitmapInfoHeader));
    FColorPaletteClass := TColorPalette.Create(Self);
    LFS.Read(FBitmapFileHeader^,SizeOf(TBitmapFileHeader));
    LFs.Position := SizeOf(TBitmapFileHeader);
    LFS.Read(FBitmapInfoHeader^,SizeOf(TBitmapInfoHeader));
    LColorPaletteSize := FBitmapInfoHeader.biClrUsed * SizeOf(TRgbQuad);
    if LColorPaletteSize <> 0 then
    begin
      LFs.Position := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader);
      LColorPalette := AllocMem(LColorPaletteSize);
      LFs.Read(LColorPalette^,LColorPaletteSize);
      FColorPaletteClass.Load(LColorPalette,LColorPaletteSize);
      FreeMem(LColorPalette);
    end;
    FHeight := FBitmapInfoHeader.biHeight;
    FWidth := FBitmapInfoHeader.biWidth;
    fPixBitFormat := Word2BitCount(FBitmapInfoHeader.biBitCount);
    if FPixBitFormat = bit_Unknown then
    begin
      if FBitmapInfoHeader <> nil then
        FreeMem(FBitmapInfoHeader);
      if FBitmapFileHeader <> nil then
        FreeMem(FBitmapFileHeader);
      LFs.Free;
      raise Exception.Create('PixBitFormat is bit_Unknown');
    end;
    if FBitmapInfoHeader.biCompression <> 0 then
    begin
      if FBitmapInfoHeader <> nil then
        FreeMem(FBitmapInfoHeader);
      if FBitmapFileHeader <> nil then
        FreeMem(FBitmapFileHeader);
      LFs.Free;
      raise Exception.Create('压缩类型不兼容');
    end;
    if FBitmapInfoHeader.biSizeImage = 0 then
      FBitmapSize := GetLineSize * Abs(FHeight)//Abs(FHeight) * Abs(FWidth) * GetPixSize
    else
      FBitmapSize := FBitmapInfoHeader.biSizeImage;
    LFs.Position := FBitmapFileHeader.bfOffBits;
    FBitmap := AllocMem(FBitmapSize);
    LFS.Read(FBitmap^,FBitmapSize);
    LFs.Free;
    CreateCLFormat;
end;
procedure TSimpleBitmap.CreateCLFormat;
begin
  case FPixBitFormat of
    bit_8:
    begin
      FFormat.Image_channel_data_type := CL_UNSIGNED_INT8;
      FFormat.Image_channel_order := CL_R;
    end;
    bit_16:
    begin
      FFormat.Image_channel_data_type := CL_UNSIGNED_INT8;
      FFormat.Image_channel_order := CL_RG;
    end;
    bit_24:
    begin
      FFormat.Image_channel_data_type := CL_UNSIGNED_INT8;
      FFormat.Image_channel_order := CL_RGB;
    end;
    bit_32:
    begin
      FFormat.Image_channel_order := CL_BGRA; //BMP - BGRA file  CL_RGB
      FFormat.Image_channel_data_type := CL_UNSIGNED_INT8;
    end;
  end;
end;
destructor TSimpleBitmap.Destroy;
begin
  if FNewBitmap then
  begin
    if FBitmap <> nil then
      FreeMem(FBitmap);
    if FColorPalette <> nil then
      FreeMem(FColorPalette);
  end;
  FreeMem(FBitmapFileHeader);
  FreeMem(FBitmapInfoHeader);
  FColorPaletteClass.Free;
  inherited;
end;
function TSimpleBitmap.GetLineSize: Int32;
begin
//int iLineByteCnt = (((m_iImageWidth * m_iBitsPerPixel) + 31) >> 5) << 2;
  Result := Abs(FWidth) * GetPixSize;
 // Result := (((Abs(FWidth) * GetPixSize) + 31) shr 5) shl 2;
end;
function TSimpleBitmap.GetLineSize(AWidth: Int32;
  APixBitFormat: TBitCount): Int32;
begin
  Result := Abs(AWidth) * GetPixSize(APixBitFormat);
 // Result := (((Abs(AWidth) * GetPixSize(APixBitFormat)) + 31) shr 5) shl 2;
end;
procedure TSimpleBitmap.GetPix(x, y: Integer;PixMem:PByte);
var
  ltmp:PByte;
begin
  ltmp := FBitmap;
  ltmp := ltmp + (GetLineSize * y) + (GetPixSize * x);
  Move(ltmp^,PixMem^,GetPixSize);
end;

function TSimpleBitmap.GetPixSize(Value: TBitCount): Int32;
begin
  case Value of
    bit_8:result := 1;
    bit_16:result := 2;
    bit_24:result := 3;
    bit_32:result := 4;
  end;
end;
function TSimpleBitmap.GetPixSize: Int32;
begin
  case FPixBitFormat of
    bit_8:result := 1;
    bit_16:result := 2;
    bit_24:result := 3;
    bit_32:result := 4;
  end;
end;
function TSimpleBitmap.InitColorPalette(ARgbQuad:array of TRgbQuad):INT32;
begin
  if Length(ARgbQuad) = 0 then Exit(0);
  //1.4.8需要调色板，其他的不需要，这里暂时不设置调色板
  FColorPaletteSize :=  Length(ARgbQuad) * SizeOf(TRgbQuad);
  FColorPalette := nil;
  if Length(ARgbQuad) <> 0 then
  begin
    FColorPalette := AllocMem(FColorPaletteSize);
    Move(ARgbQuad[0],FColorPalette^,FColorPaletteSize);
  end;
  FBitmapInfoHeader.biClrUsed := Length(ARgbQuad);
  FBitmapInfoHeader.biClrImportant := 0;
  FBitmapFileHeader.bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader) + FColorPaletteSize;
  FBitmapFileHeader.bfSize := FBitmapFileHeader.bfOffBits + FBitmapSize;
  Result:= FColorPaletteSize;
end;
procedure TSimpleBitmap.InitFileHeader;
begin
  FBitmapFileHeader.bfType := $4d42;
  FBitmapFileHeader.bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader) + FColorPaletteSize;
  FBitmapFileHeader.bfSize := FBitmapFileHeader.bfOffBits + FBitmapSize;
end;
procedure TSimpleBitmap.InitInfoHeader(AHeight,AWidth:Int32;ABitCount:Word);
begin
  FBitmapInfoHeader.biSize := SizeOf(TBitmapInfoHeader);
  FBitmapInfoHeader.biWidth := AWidth;
  FBitmapInfoHeader.biHeight := AHeight;
  FBitmapInfoHeader.biPlanes := 1;
  FBitmapInfoHeader.biBitCount := ABitCount;
  FBitmapInfoHeader.biCompression := 0;
  FBitmapInfoHeader.biSizeImage := 0;
  FBitmapInfoHeader.biXPelsPerMeter := 0;//AWidth;
  FBitmapInfoHeader.biYPelsPerMeter := 0;//AHeight;
end;
procedure TSimpleBitmap.SaveBitMapDataToFile(AFile: string);
var
  LStream:TMemoryStream;
begin
  LStream := TMemoryStream.Create;
  LStream.Write(FBitmap^,FBitmapSize);
  LStream.Position  := 0;
  LStream.SaveToFile(AFile);
  LStream.Free;
end;

procedure TSimpleBitmap.SaveToFile(AFile: string);
var
  LStream:TMemoryStream;
begin
  LStream := TMemoryStream.Create;
  //生成调色板
  FColorPaletteClass.Compile;
  LStream.Write(FBitmapFileHeader^,SizeOf(TBitmapFileHeader));
  LStream.Write(FBitmapInfoHeader^,SizeOf(TBitmapInfoHeader));
  if FColorPaletteSize > 0 then
    LStream.Write(FColorPalette^,FColorPaletteSize);
  LStream.Write(FBitmap^,FBitmapSize);
  LStream.Position  := 0;
  LStream.SaveToFile(AFile);
  LStream.Free;
end;
procedure TSimpleBitmap.SetPointer(Data: Pointer);
begin
  if FNewBitmap then
    if FBitmap <> nil then
      FreeMem(FBitmap);
  FNewBitmap := False;
  FBitmap := Data;
  CreateCLFormat;
end;
procedure TSimpleBitmap.SetPointer(AHeight, AWidth: Int32; Data: Pointer;
  DataSize: Int32; APixBitFormat: TBitCount);
begin
  if FNewBitmap then
    if FBitmap <> nil then
      FreeMem(FBitmap);
  FHeight := AHeight;
  FWidth := AWidth;
  FPixBitFormat := APixBitFormat;
  //初始化其他头信息
  InitInfoHeader(FHeight,FWidth,BitCount2Word(FPixBitFormat));
  InitFileHeader;
  FNewBitmap := False;
  if DataSize > 0 then
  begin
    FBitmapSize := Abs(AHeight) * GetLineSize;
    FBitmapSize := DataSize
  end
  else
    FBitmapSize := Abs(AHeight) * GetLineSize;
  FBitmap := Data;
  CreateCLFormat;
end;
function TSimpleBitmap.Word2BitCount(Value: Word): TBitCount;
begin
  Result := bit_Unknown;
  case Value of
    8:result := bit_8;
    16:result := bit_16;
    24:result := bit_24;
    32:result := bit_32;
  end;
end;
{ TColorPalette }
function TColorPalette.Add(R, G, B: Byte): Integer;
var
  Litem:PRgbQuad;
begin
  Litem := AllocMem(SizeOf(TRgbQuad));
  Litem.rgbRed := R;
  Litem.rgbGreen := G;
  Litem.rgbBule := B;
  Result := FColorPalette.Add(Litem);
end;
procedure TColorPalette.Clear;
begin
  FColorPalette.OnNotify := OnListFree;
  FColorPalette.Clear;
  FColorPalette.OnNotify := nil;
end;
procedure TColorPalette.Compile;
var
  i: Integer;
  LItem:PRgbQuad;
  Larray:TArray<TRgbQuad>;
begin
  SetLength(Larray,FColorPalette.Count);
  I := 0;
  for LItem in FColorPalette.ToArray do
  begin
    Larray[I] := LITEM^;
    Inc(I);
  end;
  FSender.InitColorPalette(Larray);
  SetLength(Larray,0);
end;
constructor TColorPalette.Create(ASender:TSimpleBitmap);
begin
  FSender := ASender;
  FColorPalette := TList<PRgbQuad>.Create;
end;
destructor TColorPalette.Destroy;
begin
  FColorPalette.OnNotify := OnListFree;
  FColorPalette.Free;
  inherited;
end;
function TColorPalette.GetCount: Integer;
begin
  Result := FColorPalette.Count;
end;
function TColorPalette.GetRGB(Index: integer): PRgbQuad;
begin
  if (Index >= Count) or (Index < 0) then
    Exit(nil);
  Result := FColorPalette.Items[Index];
end;
function TColorPalette.Load(ABuff: Pointer; ASize: integer): Boolean;
var
  LTmp:PByte;
  LCount:Integer;
  i: Integer;
begin
  Result := False;
  if ASize = 0 then
    Exit(true);
  if ASize < SizeOf(TRgbQuad) then
    Exit(False);
  if frac(ASize / SizeOf(TRgbQuad)) <> 0 then
    Exit(False);
  LTmp := ABuff;
  LCount := ASize div SizeOf(TRgbQuad);
  for i := 0 to LCount - 1 do
  begin
    Add(PRgbQuad(LTmp).rgbRed,PRgbQuad(LTmp).rgbGreen,PRgbQuad(LTmp).rgbBule);
    Inc(LTmp,SizeOf(TRgbQuad));
  end;
  Result := True;
end;
procedure TColorPalette.OnListFree(Sender: TObject; const Item: PRgbQuad;
    Action: TCollectionNotification);
begin
  FreeMem(Item);
end;
function TColorPalette.Remove(Index: Integer): Boolean;
begin
  Result := False;
  if (Index >= Count) or (Index < 0) then
    Exit(False);
  FColorPalette.Delete(Index);
  Result := True;
end;
end.